Shareware Grab Bag/Shareware Grab Bag.iso/007/fontedit.arc/FONTEDIT.BAS

BASIC Source File | 1984-07-04 | 7.4 KB | 339 lines

100 'font editor
110 '
120 '
130 '
140 '
150 '
160 '
170 '
180 DIM A(7,7)
190 SCREEN 1
200 CLS
210 '
220 ' define keys
230 KEY OFF
240 KEY 1,"":KEY 2,""
250 KEY 3,"":KEY 4,""
260 KEY 10,CHR$(27)
270 '
280 'set up pointer to characters
290 CBASE = &H4000
300 DEF SEG = 0
310 POKE &H7C, 0
320 POKE &H7D, &H40
330 POKE &H7E, PEEK (&H510)
340 POKE &H7F, PEEK (&H511)
350 DEF SEG
360 '
370 ACODE = 128
380 '
390 ' set up screen
400 '
410 LOCATE 1,14
420 PRINT "Font Editor"
430 FOR J = 1 TO 8
440   LOCATE 4 + J,18
450   PRINT "........";
460 NEXT J
470 '
480 LOCATE 4,1
490 PRINT "Ascii Code: ";
500 '
510 LOCATE 1,30
520 PRINT "Cursor"
530 LOCATE 2,30
540 PRINT"D Draw"
550 LOCATE 3,30
560 PRINT"E Erase"
570 LOCATE 4,30
580 PRINT"M Move"
590 LOCATE 6,1
600 PRINT"F1 -1   F2 +1"
610 LOCATE 7,1
620 PRINT"F3 -5   F4 +5"
630 LOCATE 6,30
640 PRINT"C Clear"
650 LOCATE 7,30
670 LOCATE 8,30
680 PRINT"L Load"
690 LOCATE 9,30
700 PRINT"S Save"
710 LOCATE 11,30
720 PRINT"F10  Escape"
730 '
740 GOSUB 1710
750 '
760 ' go to the main loop
770 GOSUB 1850
780 '
790 ' subroutine - Place Cursor
800 BLINK% = (BLINK% + 1) MOD 20
810 IF BLINK% < 10 THEN 880 ELSE 830
820 ' go to the main loop
830 'cursor off
840 IF A(ROW,COLUMN) = 0 THEN CH$ = "."
850 IF A(ROW,COLUMN) = 1 THEN CH$ = "#"
860 GOTO 930
870 '
880 'cursor on
890 IF CURS = -1 THEN CH$ = "-"
900 IF CURS = 0 THEN CH$ = "*"
910 IF CURS = 1 THEN CH$ = "+"
920 '
930 LOCATE 5 + ROW,18 + COLUMN
940 PRINT CH$;
950 RETURN
960 '
970 'subroutine - remove cursor
980 IF A(ROW,COLUMN) = 0 THEN CH$ = "."
990 IF A(ROW,COLUMN) = 1 THEN CH$ = "#"
1000 LOCATE 5 + ROW,COLUMN + 18
1010 PRINT CH$
1020 RETURN
1030 '
1040 'subroutine  -  show code and symbol
1050 LOCATE 4,13
1060 PRINT USING "###"; ACODE;
1070 CH = ACODE
1080 IF CH > 6 AND CH < 14 THEN CH = 32
1090 LOCATE 10,10
1100 PRINT CHR$(CH)
1110 RETURN
1120 '
1130 'subroutine  -  clear character
1140 LOCATE 23,18
1150 PRINT "Wait..."
1160 FOR I = 0 TO 7
1170 LOCATE 5 + I,18
1180 PRINT "........"
1190 FOR J = 0 TO 7
1200 A(I,7-J) = 0
1210 NEXT J
1220 NEXT I
1230 LOCATE 23,18
1240 PRINT "     "
1250 RETURN
1260 '
1270  'subroutine  - save character
1280 IF ACODE < 128 THEN 1430
1290 LOCATE 23,18:PRINT "Wait..."
1300 FOR I = 0 TO 7
1310   A0 = 0
1320   FOR J = 0 TO 7
1330     A0 = A0 + A0 + A(I,J)
1340   NEXT J
1350   POKE CBASE + 8 * (ACODE - 128) + I,A0
1360 NEXT I
1370 I = INT(ACODE/32):J = ACODE MOD 32
1380 LOCATE 15 + I,1 + J
1390 PRINT CHR$(ACODE)
1400 LOCATE 23,18:PRINT "     ";
1410 RETURN
1420 '
1430 LOCATE 23,10
1440 PRINT "Cannot save ASCII < 128";
1445 FOR I = 1 TO 1000:NEXT I
1450 LOCATE 23,10
1460 PRINT "                       ";
1470 RETURN
1480 '
1490 ' subroutine load character
1500 LOCATE 23,18
1510 PRINT "Wait..."
1520 DEF SEG
1530 COFF = CBASE + 8 * (ACODE - 128)
1540 IF ACODE > 127 THEN 1570
1550 DEF SEG = &HF000
1560 COFF = &HFA6E + 8 * ACODE
1570 FOR I = 0 TO 7
1580    A% = PEEK (COFF + I)
1590    FOR J = 0 TO 7
1600       X% = A% AND 1
1610       A(I,7 - J) = X%
1620       IF X% THEN X$ = "#" ELSE X$ = "."
1630       LOCATE 5 + I,18 + (7 - J):PRINT X$
1640       A% = INT(A% / 2)
1650    NEXT J
1660  NEXT I
1670 DEF SEG
1680 LOCATE 23,18:PRINT "       ";
1690 RETURN
1700 '
1710 ' subroutine - display all characters
1720 LOCATE 23,18:PRINT "Wait...";
1730 FOR I = 0 TO 7
1740 LOCATE 15 + I,1
1750 FOR J = 0 TO 31
1760 CH = 32 * I + J
1770 IF CH > 6 AND CH < 14 THEN CH = 32
1780 PRINT CHR$(CH);
1790 NEXT J
1800 PRINT
1810 NEXT I
1820 LOCATE 23,18:PRINT "      ";
1830 RETURN
1840 '
1850 '  Main Program
1860 '
1870 '  set cursor
1880 ROW = 0:COLUMN = 0 : CURS = 0
1890 '
1900 ' new ascii
1910 GOSUB 1040   'show code & symbol
1920 '
1930 'main loop
1940 BLINK% = 0
1950 IF CURS = -1 THEN A(ROW,COLUMN) = 0
1960 IF CURS = +1 THEN A(ROW,COLUMN) = 1
1970 '
1980 '  blink entry
1990 GOSUB 790  ' place cursor
2000 '
2010 A$ = INKEY$
2020 DEF SEG: POKE 106,0  'clear buf
2030 IF LEN(A$) = 0 THEN 1980
2040 IF LEN(A$) = 1 THEN 2080
2050 IF LEN(A$) = 2 THEN 2190
2060 GOTO 1980
2070 '
2080 '  Length = 1
2090 CODE1 = ASC(A$) AND &H5F
2100 IF CODE1 = 27 THEN 3190  ' Esc
2110 IF CODE1 = ASC("E") THEN 2880
2120 IF CODE1 = ASC("M") THEN 2920
2130 IF CODE1 = ASC("D") THEN 2960
2140 IF CODE1 = ASC("C") THEN 3230
2150 IF CODE1 = ASC("L") THEN 3270
2160 IF CODE1 = ASC("S") THEN 3310
2170 GOTO 1980
2180 '
2190 IF ASC(A$) < > 0 THEN 1930
2200 CODE2 = ASC(RIGHT$(A$,1))
2210 GOSUB 970
2220 '
2230 'CURSOR
2240 IF CODE2 = 71 THEN 2400 'HOME
2250 IF CODE2 = 73 THEN 2470 'UPPER R
2260 IF CODE2 = 79 THEN 2540 'LOWER L
2270 IF CODE2 = 81 THEN 2610 'LOWER R
2280 IF CODE2 = 72 THEN 2680 ' CURS UP
2290 IF CODE2 = 75 THEN 2730 'CURS LEFT
2300 IF CODE2 = 77 THEN 2780 ' CURS RIGHT
2310 IF CODE2 = 80 THEN 2830 ' CURS DOWN
2320 '
2330 'ASCII CODE
2340 IF CODE2 = 59 THEN 3000 ' -1
2350 IF CODE2 = 60 THEN 3050 ' +1
2360 IF CODE2 = 61 THEN 3100 ' -5
2370 IF CODE2 = 62 THEN 3140 ' +5
2380 GOTO 1980
2390 '
2400 'UPPER LEFT
2410 IF ROW = 0 THEN ROW = 8
2420 IF COLUMN = 0 THEN COLUMN = 8
2430 ROW = ROW - 1
2440 COLUMN = COLUMN - 1
2450 GOTO 1930
2460 '
2470 'UPPER RIGHT
2480 IF ROW = 0 THEN ROW = 8
2490 IF COLUMN = 7 THEN COLUMN = -1
2500 ROW = ROW - 1
2510 COLUMN = COLUMN  + 1
2520 GOTO 1930
2530 '
2540 'LOWER LEFT
2550 IF ROW = 7 THEN ROW = -1
2560 IF COLUMN = 0 THEN COLUMN = 8
2570 ROW = ROW + 1
2580 COLUMN = COLUMN - 1
2590 GOTO 1930
2600 '
2610 ' LOWER RIGHT
2620 IF ROW = 7 THEN ROW = -1
2630 IF COLUMN = 7 THEN COLUMN = -1
2640 ROW = ROW + 1
2650 COLUMN = COLUMN +1
2660 GOTO 1930
2670 '
2680 'CURS UP
2690 IF ROW = 0 THEN ROW = 8
2700 ROW = ROW - 1
2710  GOTO 1930
2720 '
2730 ' CURS LEFT
2740 IF COLUMN = 0 THEN COLUMN = 8
2750 COLUMN = COLUMN - 1
2760 GOTO 1930
2770 '
2780 ' CURS RIGHT
2790 IF COLUMN = 7 THEN COLUMN = -1
2800 COLUMN = COLUMN + 1
2810 GOTO 1930
2820 '
2830 'CURS DOWN
2840 IF ROW = 7 THEN ROW = -1
2850 ROW = ROW + 1
2860 GOTO 1930
2870 '
2880 'ERASE
2881 FOR G = 1 TO 4
2882 LOCATE G,28:PRINT " "
2883 NEXT
2884 LOCATE 3,28:PRINT CHR$(16)
2890 CURS = -1
2900 GOTO 1930
2910 '
2920 'MOVE
2921 FOR G = 1 TO 4
2922 LOCATE G,28:PRINT " "
2923 NEXT
2924 LOCATE 4,28:PRINT CHR$(16)
2930 CURS = 0
2940 GOTO 1930
2950 '
2960 'DRAW
2961 FOR G = 1 TO 4
2962 LOCATE G,28:PRINT " "
2963 NEXT
2964 LOCATE 2,28:PRINT CHR$(16)
2970 CURS = +1
2980 GOTO 1930
2990 '
3000 'ASCII -1
3010 IF ACODE = 0 THEN 3030
3020 ACODE = ACODE -1
3030 GOTO 1900
3040 '
3050 'ASCII +1
3060 IF ACODE = 255 THEN 3080
3070 ACODE = ACODE + 1
3080 GOTO 1900
3090 '
3100 'ASCII = -5
3110 IF ACODE < 5 THEN 3130
3120 ACODE = ACODE - 5
3130 GOTO 1900
3140 'ASCII +5
3150 IF ACODE > 250 THEN 3170
3160 ACODE = ACODE + 5
3170 GOTO 1900
3180 '
3190 'ESCAPE FROM PROGRAM
3200 LOCATE 23,1
3210 GOTO 3350
3220 '
3230 'CLEAR
3240 GOSUB 1130
3250 GOTO 1840
3260 '
3270 'LOAD
3280 GOSUB 1490 ' LOAD
3290 GOTO 1840
3300 '
3310 'SAVE
    08/11/84 00:52
PAGE    .COM    768   A 12/03/83 17:21   POLICE  .BAS   8704     08/11/84 00:59
MVPFORTH.AQM  34225   A 06/16/84 23:19   CPU8086 .BQK  14848     08/11/84 01:06
LBN     .DOC   3200   A 01/10/84 22:45   UTILITY .BQK  35712     08/11/84 01:14
LBN     .EXE  15872   A 01/10/84 22:49   EXTEND86.BQK   8832     08/11/84 01:34
PAC-GIRL.EQE  41205   A 01/20/84 11:44